# 
# Copyright (c) 2002-2007 Eric Wallengren
# This file is part of the Continuous Automated Build and Integration 
# Environment (CABIE)
# 
# CABIE is distributed under the terms of the GNU General Public
# License version 2 or any later version.  See the file COPYING for copying 
# permission or http://www.gnu.org. 
#                                                                            
# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED OR  
# IMPLIED, without even the implied warranty of MERCHANTABILITY or FITNESS 
# FOR A PARTICULAR PURPOSE.  ANY USE IS AT YOUR OWN RISK. 
#                                                                            
# Permission to modify the code and to distribute modified code is granted, 
# provided the above notices are retained, and a notice that the code was 
# modified is included with the above copyright notice. 
# 

#
# This package is specifically for running the buildserver and source monitor
# under Windows using ActiveState as the deployment platform.
#

BEGIN{
    push @INC, ".";
    push @INC, "lib";
    push @INC, "../lib";
}

#
# Package declaration
#
package winsys;

use vars qw( $Log $Message $Name $Value );

#
# Use Carp for error handling
#
use Carp;

use Win32;
use Win32::OLE qw( in );
use Win32::OLE::Variant;
use Win32::Daemon;
use Win32::Process;
use Win32::Process::Info;
my $pi = Win32::Process::Info->new (undef, 'WMI');
use Win32::Job;
use Win32::AdminMisc;
use Sys::Hostname;
use FileHandle;

my $hostname = hostname();
$hostname    =~ s/\.[a-zA-Z0-9]+//g;
my $configname = $hostname;
$configname    =~ s/-//g;

require "$configname.pm";

my $config = new $configname;

my $pi = Win32::Process::Info->new (undef, 'WMI');

#
# Uncomment if you're using MySQL
#
use DBI;
DBI->trace(0);

#
# Global section, please do not edit!!!
# All these values will be set at startup.
#
my %fields = (
    sport         => '9190',
    mport         => '9192',
    port          => '9190',
    makemonitor   => '0',
    makedaemon    => '0',
    bAmMonitor    => '0',
    bAmServer     => '0',
    serverpid     => '-1',
    monitorpid    => '-1',
    nativein      => '0',
    nativeout     => '0',
    nativeerr     => '0',
    volume        => 'NA',
    jobname       => 'NA',
    jobno         => '0',
    threadlock    => '0',
    hostname      => 'NA',
    verbosefuncs  => '0',
    verboselogs   => '1',
);

#
# Read commandline args
#
sub validateargs {

    my $self = shift;

    my $hostname = shift;

    my %Opts = @_;

    my $key;
    my $bMissing = 0;
    my $sport;
    my $mport;
    my $BSR = $config->BSR;
    $BSR =~ s/\//\\/g;

    my @windowsargs  = qw (m s i r);

    if (!defined($Opts{x})) {

        #
        # This will be for a service installation...
        #
        foreach $arg (@windowsargs) {

            if (!defined($Opts{m}) || !defined($Opts{s}) ||
               ( !defined($Opts{i}) && !defined($Opts{r})) ) {
               if ($bMissing == 0) {
                   print "Incomplete options: ";
                   $bMissing = 1;
               }
               print " -$arg";
            }
        }

        if ($bMissing) {

            print "\n";
            exit -1;

        }

        #
        # Look for -s (server port)
        #
        if ($Opts{s} !~ /^$/ ) {
            if ($Opts{s} !~ /^[0-9]+$/ ) {
                print "Invalid port number!\n";
                exit 1;
            } else {
                $sport = $Opts{s};
            }
        }

        #
        # Look for -m (monitor port)
        #
        if ($Opts{m} !~ /^$/ ) {
            if ($Opts{m} !~ /^[0-9]+$/ ) {
                print "Invalid port number!\n";
                exit 1;
            } else {
                $mport = $Opts{m};
            }
        }
        #
        # Next 2 hashes are for the service install...
        #
        my %BuildServiceHash = (
            machine     =>  "$hostname",
            name        =>  'buildserver',
            display     =>  'CABIE build monitor service',
            path        =>  $^X,
            user        =>  '',
            pwd         =>  '',
            description => "Monitor output of builds on $hostname",
            parameters  => "-I$BSR\\lib $BSR\\buildserver.pl -x -s $sport",
        );

        my %MonitorServiceHash = (
            machine     =>  "$hostname",
            name        =>  'testserver',
            display     =>  'CABIE test monitor service',
            path        =>  $^X,
            user        =>  '',
            pwd         =>  '',
            description => "Monitor tests for $hostname",
            parameters  => "-I$BSR\\lib $BSR\\buildserver.pl -x -m $mport",
        );

        #
        # Can't install and remove services at the same time...
        #
        if ( defined($Opts{i}) && defined ($Opts{r}) ) {
            print "cannot install and remove an NT service!\n";
            exit 1;
        }

        #
        # Delete the services...
        #
        if (defined($Opts{r})) {
            if( Win32::Daemon::DeleteService( 'buildserver' )) {
                print "Successfully deleted.\n";
            } else {
                print "Failed to remove buildserver service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

            if( Win32::Daemon::DeleteService( 'testserver' )) {
                print "Successfully deleted.\n";
            } else {
                print "Failed to remove test service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }
        }

        #
        # Install the services...
        #
        if (defined($Opts{i})) {
            if( Win32::Daemon::CreateService( \%BuildServiceHash )) {
                print "Successfully installed.\n";
            } else {
                print "Failed to install buildserver service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

            if( Win32::Daemon::CreateService( \%MonitorServiceHash )) {
                print "Successfully installed.\n";
            } else {
                print "Failed to install test server service: " . 
                    Win32::FormatMessage( Win32::Daemon::GetLastError() ) . 
                                          "\n";
            }

        }

        exit 0;

    }

}

#
# Start the NT build/monitor services
#
sub startdaemons {

    my $self    = shift;
    my $dir     = shift;
    my $Mtmpdir = sprintf "%s", $config->BTMP;
    my $Mnull   = sprintf "%s", $config->NULL;

    my %Opts = @_;

    if (defined($Opts{x})) {

        #
        # If -d was specified on the command line, disconnect filehandles,
        # set appropriate fields and start the service.
        #
        $self->makedaemon('1');

        #
        # If we're the buildserver
        #
        if (defined($Opts{s})) {
            $self->port($Opts{s});
            $self->bAmServer('1');
            $self->serverpid("build service");
            print $self->bAmServer."\n";
            close(STDIN);
            close(STDOUT);
            close(STDERR);
            open STDIN, "$Mnull" ||die "open $!";
            open STDOUT, ">$dir/logs/bsdaemon.log" || die "open $!";
            open STDERR, ">$dir/logs/bserror.log" || die "open $!";
            print "***$port starting server daemon***\n";
        }

        #
        # If we're the buildserver monitor
        #
        if (defined($Opts{m})) {
            $self->port($Opts{m});
            $self->bAmMonitor('1');
            $self->serverpid("monitor service");
            $logext = "_connectlog";
            close(STDIN);
            close(STDOUT);
            close(STDERR);
            open STDIN, "$Mnull" ||die "open $!";
            open STDOUT, ">$dir/logs/msdaemon.log" || die "open $!";
            open STDERR, ">$dir/logs/mserror.log" || die "open $!";
            print "***$port starting monitor daemon***\n";
        }

        Win32::Daemon::StartService();

        $self->_logpid("monitor", "NT Service");
        $self->_logpid("server", "NT Service");

        #
        # Wait until the service manager is ready for us to continue...
        #
        while( SERVICE_START_PENDING != Win32::Daemon::State() ) {
            sleep( 1 );
        }
        
        #
        # Now let the service manager know that we are running...
        #
        Win32::Daemon::State( SERVICE_RUNNING );
        print STDERR "Service is running\n";

        #
        # Win32::Daemon::State( 1 );
        #
        $self->nativein(fileno(STDIN));
        $self->nativeout(fileno(STDOUT));
        $self->nativeerr(fileno(STDERR));

    }

}

#
# Clean up lock files...
#
sub _cleanuplocks {

    my $self = shift;

    my $BSR = $config->BSR;

    my $sqlquery;
    my @sqlarray;

    my $entry;

    $sqlquery = "select title,top from configuration where server=".
                "\"$hostname\" and state=\"0\"";

    @sqlarray = $self->run_sql_query($sqlquery, ";");

    foreach $entry ($sqlquery) {

        my ($title, $top) = split(/;/, $entry);
        
        if (-f "$top/$title.out") {
            unlink("$top/$title.out");
        }
        
        if (-f "$top/$title.stdout") {
            unlink("$top/$title.stdout");
        }
        
        if (-f "$BSR/$title.out") {
            unlink("$BSR/$title.out");
        }
        
        if (-f "$BSR/$title.stdout") {
            unlink("$BSR/$title.stdout");
        }

    }

}

sub _monitor {

    my $self = shift;
    my $state;
    my $message;

    my $previous = Win32::Daemon::State();

    my $c = 1;

    sleep(10);

    print STDERR "previous: $previous\n";

    while (($state = Win32::Daemon::State()) != SERVICE_STOPPED ) {

        print STDERR "($c) state is $state\n";

        #if ($state == SERVICE_START_PENDING) {
        #    Win32::Daemon::State(SERVICE_RUNNING);
        #    $previous = SERVICE_RUNNING;
        #}
        #elsif ($state == SERVICE_PAUSE_PENDING) {
        if ($state == SERVICE_PAUSE_PENDING) {
            Win32::Daemon::State(SERVICE_PAUSED);
            $previous = SERVICE_PAUSED;
        }
        elsif ($state == SERVICE_CONTINUE_PENDING) {
            Win32::Daemon::State(SERVICE_RUNNING);
            $previous = SERVICE_RUNNING;
        }
        elsif ($state == SERVICE_PAUSE_PENDING) {
            Win32::Daemon::State(SERVICE_PAUSED);
            $previous = SERVICE_PAUSED;
            next;
        }
        elsif ($state == SERVICE_CONTINUE_PENDING) {
            Win32::Daemon::State(SERVICE_RUNNING);
            $previous = SERVICE_RUNNING;
            next;
        }
        elsif ($state == SERVICE_STOP_PENDING) {
            $self->_stopservice();
            $previous = SERVICE_STOPPED;
            next;
        } else {
            Win32::Daemon::State($previous);
        }

        if( SERVICE_CONTROL_NONE != 
            ( $message = Win32::Daemon::QueryLastMessage(1))) {
            if ($message == SERVICE_CONTROL_INTERROGATE) {
                Win32::Daemon::State($previous);
            }
            elsif ($message == SERVICE_CONTROL_SHUTDOWN) {
                Win32::Daemon::State(SERVICE_STOP_PENDING, 25000);
            }
        }

        Win32::Sleep(20);

        $c++;
    }

}

#
# Function to use as the callback for the windows service
#
sub _stopservice {

    my $self    = shift;

    $self->_cleanuplocks();

    Win32::Daemon::State( SERVICE_STOPPED );
        
    #
    # We need to notify the Daemon that we want to stop callbacks 
    # and the service.
    #
    Win32::Daemon::StopService();

}

#
# Shutdown the service
#
sub shutdown {

    return "Use the control panel to terminate this service";

}

#
# Return process array for NT
#
sub processtable {

    my $self = shift;
    my @psarray;
    my %pshash;

    my $user;
    my $pid;
    my $ppid;
    my $cpu;
    my $start;
    my $tty;
    my $run;
    my $path;

    my @psdata;

    $time = time;

    @psdata = $pi->GetProcInfo();

    foreach my $record (@psdata) {
        my %procentry = %{ $record };
	$user  = $procentry{Owner};
	$pid   = sprintf("%05d", $procentry{ProcessId});
	$ppid  = $procentry{ParentProcessId};
	$cpu   = 'NA';
	$start = $self->_when_started($procentry{CreationDate});
	$tty   = '?';
	$run   = $self->_format_elapsed_time($time - $procentry{CreationDate});
	if ($procentry{ExecutablePath} =~ /^$/) {
	    $path  = $procentry{Description};
        } else {
	    $path  = $procentry{ExecutablePath};
        }
	$pshash{$pid} = (
            'values' => {
                'user'   => $user,
                'ppid'   => $ppid,
                'cpu'    => $cpu,
                'start'  => $start,
                'tty'    => $tty,
                'run'    => $run,
                'path'   => $path,
	    },
        );
    }

    foreach $record (sort keys %pshash) {

        my ($domain, $login) = split(/\\/, $pshash{$record}{user});

	if ($login =~ /^$/) {
            $login = "unknown";
        } 

	$entry = sprintf("%-13s %5d %5d %2s %5s %7s %8s %-30s\n", 
		         $login, $record, 
                         $pshash{$record}{ppid},
                         $pshash{$record}{cpu},
			 $pshash{$record}{start},
			 $pshash{$record}{tty},
			 $pshash{$record}{run},
			 $pshash{$record}{path},
		         );

	push @psarray, $entry;

    }

    return @psarray;

}

sub _format_elapsed_time {

    my $self       = shift;
    my $difference = shift;

    my $seconds    =  $difference % 60;
    my $difference = ($difference - $seconds) / 60;
    my $minutes    =  $difference % 60;
    my $difference = ($difference - $minutes) / 60;
    my $hours      =  $difference % 24;
    my $difference = ($difference - $hours)   / 24;
    my $days       =  $difference % 7;
    my $weeks      = ($difference - $days)    /  7;

    my $returnstring = sprintf("%02d:%02d:%02d", $hours, $minutes,$seconds);

    return $returnstring;

}

sub getloginname {

    my $self = shift;

    my $login = 'NA';

    return $login;

}

sub _logpid {

    my $self = shift;
    my $type = shift;
    my $pid  = shift;

    my $sqlquery;
    my @sqlarray;
    my @sqlsubmit;

    $sqlquery = "select * from serverids where binary server=\"$hostname\" ".
                "and type=\"$type\"";

    @sqlarray = $self->run_sql_query("$sqlquery", ",", 0);

    if (@sqlarray == 0) {
        push @sqlsubmit, "$hostname";
        push @sqlsubmit, "$type";
        push @sqlsubmit, "$pid";
        $self->run_sql_submit("serverids", @sqlsubmit);
    } else {
        $sqlquery = "update serverids set pid=\"$pid\" where ".
                    "binary server=\"$hostname\" and type=\"$type\"";
        @sqlarray  = $self->run_sql_query("$sqlquery", ";", 0);
    }

}

sub _when_started {

    my $self = shift;
    my $time = shift;

    my $day = 60*60*24;

    my $now = time;

    my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,
        $yday,$isdst)=gmtime($time);


    if (($now - $time) > $day) {
        $str = sprintf "%3s%02d",
                       $abbr[$mon],$mday;
    } else {
        $str = sprintf "%02d:%02d",
                       $hour,$min;
    }

    return $str;

}

#
# Get average MAX duration for the job
#
sub _get_average {

    my $self   = shift;
    my $server = shift;
    my $title  = shift;
    my $total  = 0;
    my $keep;

    my $sqlquery;
    my @sqlarray;

    my $line;

    $sqlquery = "select keeplevel from configuration where binary ".
                "title=\"$title\" and binary server=\"$server\"";

    @sqlarray = $self->run_sql_query($sqlquery, ";", 0);

    $keep = $sqlarray[0];

    $sqlquery = "select start,end from jobs where binary ".
                "title=\"$title\" and binary server=\"$server\" ".
                "and status!=\"2\" order by job desc limit $keep";

    @sqlarray = $self->run_sql_query($sqlquery, ";", 0);

    $max = 0;
    $min = 0;
    $sum = 0;
    $rec = @sqlarray;

    foreach $line (@sqlarray) {

        ($start, $end) = split(/;/, $line);
        $elapsed = $end-$start;

        if (!$min) {
            $min = $elapsed;
        }

        if ($elapsed < $min) {
            $min = $elapsed;
        } 

        if ($elapsed > $max) {
            $max = $elapsed;
        } 

        $sum += $elapsed;

    }

    if ($rec > 0) {
        if ($rec == 1) {
            $max *= .1;
            return $max;
        } 
        if ($rec == 2) {
            $total  = $sum/2;
            $t      = $total * .1;
            $total += $t;
            return $total;
        }
        if ($rec > 2) {
            $rec   = $rec - 2;
            $sum  -= $max;
            $sum  -= $min;
            $total = $sum / $rec;
            $t     = $total * .1;
            $total += $t;
            return $total;
        }
    
    } else {
        return 0;
    }

}

sub _get_hosttime {

    my $self = shift;

    my $sqlquery = "select unix_timestamp()";

    my @sqlarray = $self->run_sql_query($sqlquery, ";");

    return $sqlarray[0];

}

sub run_sql_submit {

    my $self   = shift;
    my $table  = shift;
    my @values = @_;

    my $picture;
    my $count  = 0;

    my $sqlserver = $config->SQLSERVER;
    my $sqlid     = $config->SQLID;
    my $sqlpass   = $config->SQLPASS;
    my $dbh;
    my $sth;

    my $ret = 1;

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", "$sqlpass"); 

    if (defined($dbh)) {

        while ($count < @values) {
            $picture .= "?, ";
            $count++;
        }

        $picture =~ s/, $//g;

        $sth = $dbh->prepare("INSERT INTO $table VALUES($picture)");

        $sth->execute(@values);

        $sth->finish();

        $dbh->disconnect;

    } else {
        $ret = 0;
    }

    return $ret;

}

sub run_sql_remove {

    my $self       = shift;
    my $sqlquery   = shift;

    my $sqlserver  = $config->SQLSERVER;
    my $sqlid      = $config->SQLID;
    my $sqlpass    = $config->SQLPASS;

    my $dbh;
    my $sth;

    my $ret        = 1;

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", "$sqlpass");

    if (defined($dbh)) {
        $sth = $dbh->prepare($sqlquery);

        $sth->execute();

        $sth->finish();

        $dbh->disconnect;

    } else {
        $ret = 0;
    }

    return $ret;

}

sub run_sql_query {

    my $self       = shift;
    my $sqlquery   = shift;
    my $delimeter  = shift;
    my $direction  = shift;

    my $sqlserver  = $config->SQLSERVER;
    my $sqlid      = $config->SQLID;
    my $sqlpass    = $config->SQLPASS;

    my $dbh;
    my $sth;
    my $line;
    my $record;

    my @ret;
    my @row;

    if ($sqlquery =~ /delete from/i) {
        return "cannot delete records from query function";
    }
    if ($sqlquery =~ /drop table/i) {
        return "cannot drop tables from query function";
    }

    $dbh = DBI->connect("dbi:mysql:database=builds;host=$sqlserver",
        "$sqlid", "$sqlpass");

    if ($sqlquery =~ /\"\"/ && defined($dbh)) {
       $dbh->disconnect;
       undef $dbh;
    }

    if (defined($dbh)) {
        $sth = $dbh->prepare($sqlquery);

        $sth->execute();

        #
        # If this is not an update statement
        #
        if ($sqlquery !~ /^update/ic ) {
            while ( @row = $sth->fetchrow_array ) {
                $record = "";
                foreach $line (@row) {
                    chomp $line;
                    $record .= "$line"."$delimeter";
                }
    
                $record =~ s/$delimeter$//g;
    
                if ($direction) {
                    unshift @ret, $record;
                } else {
                    push @ret, $record;
                }
    
            }
        }

        $sth->finish();

        $dbh->disconnect;

        return @ret;

    } else {
        return undef;
    }

}

#
# Kill process by pid
#
sub kill {

    my $self  = shift;

    my $entry = shift;

    Win32::Process::KillProcess($entry, $exitcode);

}

#
# Fork a process and return pid to calling app
#
sub forkprocess {

    my $self  = shift;
    my $cmd   = shift;
    my $wait  = shift;
    my $sleep = shift;
    my @args  = @_;

    my $job;
    my $pid;

    $cmd .= " ";

    #
    # Strip apart arg array since args will all be on a 
    # single command line
    #
    foreach my $entry (@args) { $cmd .= "$entry "; }

    $cmd =~ s/ $//g;

    my $ProcessObj;

    #
    # We'll always use cmd.exe for the shell
    #
    $executable = $self->whereis("cmd.exe");

    if (!$wait) {

        sleep($sleep);
        #
        # Create the process object
        #
        Win32::Process::Create($ProcessObj, "$executable",
                               "cmd /c $cmd",
                               0,
                               CREATE_NEW_CONSOLE,
                               ".") || die ErrorReport();
    
        #
        # Get the pid
        #
        $pid = $ProcessObj->GetProcessID();

    } else {
        
        my $sqlquery;
        my @sqlarray;

        #
        # Grab info from config
        #
        my $title = $self->jobname;
        my $jobno = $self->jobno;
        my $host  = $self->hostname;

        my $status;

        #
        # Create then spawn the job
        #
        $job = Win32::Job->new;
        $pid = $job->spawn("$executable", "cmd /c $cmd");

        #
        # Push pid onto process tree table
        #
        push @sqlarray, "$host";
        push @sqlarray, "$title";
        push @sqlarray, "$jobno";
        push @sqlarray, "$cmd";
        push @sqlarray, "$pid";

        $self->run_sql_submit("proctree", @sqlarray);

        #
        # Wait untile the process has completed
        #
        $job->run(3600, 1);

        $status = $job->status();

        #
        # Remove all entries from proctree associated with this job
        #
        $sqlquery  = "delete from proctree where binary server=".
                     "\"$host\" and title=\"$title\" ".
                     "and pid=\"$pid\"";

        $self->run_sql_remove("$sqlquery");

        return $$status{$pid}{exitcode};

    }

    #
    # Return pid
    #
    return $pid;

}

#
# Handle svn updates to stdout since windows 
# isn't a posix OS (no pipes, fork or other 
# normal expected behaviors)
#
sub cvs_update {

    my $self   = shift;

    my $client = shift;
    my $title  = shift;
    my $top    = shift;
    my $action = shift;

    my @modules = split(/ /, $client);

    my $entry;
    my @children;
    my @contents;

    my $count = 0;

    my $logtype;
    my $lock;

    my $BSR = $config->BSR;

    $bwait = 1;

    my $location = $self->whereis("cvs.exe");

    my $job = Win32::Job->new;

    if (!defined($location)) {
        print "unable to find cvs executable";
        return undef;
    }

    if ($action) {
        $logtype = "out";
        $lock = "out";
    } else {
        $logtype = "stdout";
        $lock = "stdout";
    }

    while ( $bwait ) {
        if (! -f "$title.$lock" ) {
            $bwait = 0;
        } else {
             sleep(1);
        }
    }

    #
    # We need to create a lock so that files don't get overwritten
    #
    open(LOCKFILE, ">$title.$lock");
    close(LOCKFILE);
    
    $location =~ s/\//\\\\/g;

    chdir $top || die "unable to chdir";

    foreach $entry (@modules) {

        if (!$action) {
            $job->spawn("$location", "cvs -n -d$port up -d $entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        } else {
            $job->spawn("$location", "cvs -d$port up -d -P $entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        }
 
    }

    $job->run(3600, 1);

    foreach $entry (@modules) {

        if ( -f "$entry.$logtype.log" ) {
            open (TMPLOG, "<$entry.$logtype.log")
                  || die "cannot open $entry.stdout.log";
            while (<TMPLOG>) {
                push @contents, "$_";
            }
            close (TMPLOG);
            unlink("$entry.$logtype.log");
        }
        if (-f "$entry.$logtype.err" ) {
            unlink ("$entry.$logtype.err") || die "unlink: $?";
        }
        
	my $cvsout;
	my $cvserr;

	#
	# Threads under windows forces the logs to be written to a
	# location other than the one I expect, the directory where 
	# buildserver was called from.  We'll look for the logs in the
	# top level directory, if they're not there look under the
	# buildserver root.
	#
        if ( -f "$top/$entry.$logtype.log" ) {
            $cvsout = "$top/$entry.$logtype.log";
        } elsif ( -f "$BSR/$entry.$logtype.log") {
            $cvsout = "$BSR/$entry.$logtype.log";
        }

        open (TMPLOG, "<$cvsout") 
              || die "cannot open $cvsout";

        while (<TMPLOG>) {
            push @contents, "$_";
        }
        close (TMPLOG);

        unlink("$cvsout");

        if ( -f "$top/$entry.$logtype.err" ) {
            $cvserr = "$top/$entry.$logtype.err";
        } elsif ( -f "$BSR/$entry.$logtype.err") {
            $cvserr = "$BSR/$entry.$logtype.err";
        }

        if (-f "$cvserr" ) {
	    unlink ("$cvserr") || die "unlink: $?";
        }
    }

    unlink("$title.$lock");
    
    return @contents;

}

#
# Handle svn updates to stdout since windows 
# isn't a posix OS (no pipes, fork or other 
# normal expected behaviors)
#
sub subversion_update {

    my $self   = shift;

    my $client = shift;
    my $title  = shift;
    my $top    = shift;
    my $action = shift;

    my @modules = split(/ /, $client);

    my $entry;
    my @children;
    my @contents;

    my $count = 0;

    my $logtype;
    my $lock;

    my $BSR = $config->BSR;

    $bwait = 1;

    my $location = $self->whereis("svn.exe");

    my $job = Win32::Job->new;

    if (!defined($location)) {
        print "unable to find svn executable";
        return undef;
    }

    if ($action) {
        $logtype = "out";
        $lock = "out";
    } else {
        $logtype = "stdout";
        $lock = "stdout";
    }

    while ( $bwait ) {
        if (! -f "$title.$lock" ) {
            $bwait = 0;
        } else {
             sleep(1);
        }
    }

    #
    # We need to create a lock so that files don't get overwritten
    #
    open(LOCKFILE, ">$title.$lock");
    close(LOCKFILE);
    
    $location =~ s/\//\\\\/g;

    chdir $top || die "unable to chdir";

    foreach $entry (@modules) {

        if (!$action) {
	    $job->spawn("$location", "svn.exe status -u $top\\$entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        } else {
	    $job->spawn("$location", "svn.exe update $top\\$entry", {
                stdin  => 'NUL',
                stdout => "$entry.$logtype.log", 
                stderr => "$entry.$logtype.err",
            });
        }
 
    }

    $job->run(3600, 1);

    foreach $entry (@modules) {
        
	my $svnout;
	my $svnerr;

	my $tmptop;

	$tmptop =  $top;
	$tmptop =~ s/\\/\//g;

	#
	# Threads under windows forces the logs to be written to a
	# location other than the one I expect, the directory where 
	# buildserver was called from.  We'll look for the logs in the
	# top level directory, if they're not there look under the
	# buildserver root.
	#
        if ( -f "$top/$entry.$logtype.log" ) {
            $svnout = "$top/$entry.$logtype.log";
        } elsif ( -f "$BSR/$entry.$logtype.log") {
            $svnout = "$BSR/$entry.$logtype.log";
        }

        open (TMPLOG, "<$svnout") 
              || die "cannot open $svnout";

        while (<TMPLOG>) {

            chomp;

	    # This has to go
	    $_ =~ s/\\/\//g;
	    $_ =~ s/$tmptop\///ic;

            if ($_ !~ /Status against revision/ && $_ !~ /^$/) {
                push @contents, "$_\n";
            }

        }

        close (TMPLOG);

        unlink("$svnout");

        if ( -f "$top/$entry.$logtype.err" ) {
            $svnerr = "$top/$entry.$logtype.err";
        } elsif ( -f "$BSR/$entry.$logtype.err") {
            $svnerr = "$BSR/$entry.$logtype.err";
        }

        if (-f "$svnerr" ) {
	    unlink ("$svnerr") || die "unlink: $?";
        }
    }

    unlink("$title.$lock");
    
    return @contents;

}

#
# Background copy for win32 (for promoting builds)
#
sub wincopyfiles {

    my $self = shift;

    my $from = shift;
    my $to   = shift;
    my $xcopy;

    $from    =~ s/[\/]/\\/g;
    $to      =~ s/[\/]/\\/g;

    my $ProcessObj;

    $xcopy = $self->whereis("xcopy.exe");
    $xcopy    =~ s/\//\\\\/g;

    Win32::Process::Create($ProcessObj, "$xcopy",
                           "xcopy $from $to /i/s/y",
                           0,
                           CREATE_NEW_CONSOLE,
                           ".") || die ErrorReport();
}

#
# Windows again...
#
sub cvs_wait {

    my $self  = shift;
    my @pids  = shift;

    my $one;
    my $mee;

}

#
# Find any file located in %PATH
#
sub whereis {

    my $self     = shift;
    my $filename = shift;

    my $bfound   = 0;
    my $envvar   = $ENV{PATH};
    my $entry;

    my @patharray = split(/;/, $envvar);

    foreach $entry (@patharray) {
        $entry =~ s/:$//g;
        $entry =~ s/\\/\//g;

        if (-f "$entry/$filename") {
            print "found $filename\n";
            return "$entry/$filename";
        }
    }

    return undef;

}

#
# Return free space
#
sub diskspace {

    my $self = shift;
    my $type = shift;

    my $Drive;
    
    if ($type) {
        $Drive = $config->PROMOTION;
    } else {
        $Drive = $config->JOBDIR;
    }

    my ($left, $right) = split(":", $Drive);

    $self->volume($left);

    my @Geometry = Win32::AdminMisc::GetDriveGeometry("$left:\\");

    my $Free = $Geometry[0] * $Geometry[1] * $Geometry[2];

    return $Free;

}

#
# System HW/SW information
#
sub sysinfo {

    my $self = shift;
    my $info;
    my @OS_TYPE = qw(
        Windows_3x Windows_95 Windows_98 Windows_NT Windows_CE 
    );

    my $Class = "Win32_OperatingSystem";

    (my $Machine = shift @ARGV || "." ) =~ s/^[\\\/]+//;

    my $WMIServices = Win32::OLE->GetObject( 
        "winmgmts:{impersonationLevel=impersonate,(security)}//$Machine" ) 
        || die;

    foreach my $OS ( in( $WMIServices->InstancesOf( $Class ) ) ) {
  
        $info  = "$OS->{Caption} ".
                 "$OS->{Version} ".
                 "$OS->{CSDVersion}";

    }

    return $info;

}

#
# For producing win32 error strings.
#
sub ErrorReport{
    print Win32::FormatMessage( Win32::GetLastError() );
}

#
# Write logs
#
sub tracefunction {

    my $self   = shift;
    my $string = shift;

    my $formattime;
    my $reqtime = scalar localtime;

    if ($fields{verbosefuncs}) {
        print STDERR "[$reqtime]: $string\n";
    }

}

sub writelog {

    my $self   = shift;
    my $string = shift;
    my $F      = shift;

    my $formattime;
    my $reqtime = scalar localtime;

    if ($fields{verboselogs}) {
        print $F "[$reqtime]: $string\n";
    }

}

#
# Do not edit anything below this line...
#
# Object constructor...
#
sub new {

    my $that = shift;
    my $class = ref($that) || $that;
    my $self = {
        %fields,
    };
    bless $self, $class;
    return $self;
}

#
# Autoload definitions in this package...
#
sub AUTOLOAD {

    my $self = shift;
    my $type = ref($self) || croak "$self is not an object";
    my $name = $AUTOLOAD;
    $name =~ s/.*://;
    unless (exists $self->{$name}) {
        croak "Can't access `$name` field in an object of class $type";
    }
    if (@_) {
        return $self->{$name} = shift;
    } else {
        return $self->{$name};
    }
}

1;
